I conduct a STM (Strucutral Topic Model) estimation on a sample of 14,936 online news articles from seven news provider about domestic politics: Bild.de, DIE WELT, FOCUS ONLINE, SPIEGEL ONLINE, Stern.de, ZEIT ONLINE, Tagesschau.de. The articles are dated from 01.06.2017 to 31.12.2017 (German federal elections took place on 24th of September 2017.). I first extract all online articles using the the Eventregistry API. Then all articles from the section “domestic policy” are filtered by checking the URL structure.

To discover the latent topics in the corpus, the structural topic modeling (STM) developed by Roberts (2016) is applied. The STM is an unsupervised machine learning approach that models topics as multinomial distributions of words and documents as multinomial distributions of topics, allowing to incorporate external variables that effect both, topical content and topical prevalence. I will included the news provider as a control for both the topical content and the topical prevalence. Additional, the month an article was published is included as a control for the topical prevalence. The number of topics is set to 35.

Distribution of articles

The Figures below show the distribution of the number of articles from the respective news sources by date. There is a high peak around the federal elections on September, 24th.

ggsave({
  btw %>%
  ggplot(aes(site)) +
  geom_bar(fill=col[8], alpha = 0.8) +
  labs(x="", y="Number of articles") +
  theme(
      legend.position   = "none"
    )
  
},
filename = "../figs/bar.png", device = "png", 
width = 6, height = 4,
        dpi = 600)
plot1

plot1

ggsave({
  btw %>%
  group_by(date) %>%
  dplyr::summarise(obs = n()) %>%
  ggplot(aes(date, obs)) +
  geom_line(color=col[3]) +
  geom_vline(aes(xintercept=as.Date("2017-09-24")),
             linetype = 2, color=col[5]) +
  scale_color_manual(values = col) +
  labs(x="", y="number of articles",color="") +
  scale_x_date(breaks = date_breaks("1 month"), labels=date_format("%B", tz="CET")) +
  theme(
      legend.position   = "none",
      axis.title.x      = element_blank(),
      axis.text       = element_text(size = 8)
    )
},
filename = "../figs/timeline.png", device = "png",width = 6, height = 4,
dpi = 600
)
plot1

plot1

2. Model Results

Label topics

In order to improve readability and traceability, I assign a shorter name to the topics based on the most common words. The plotQuote function allows to inspect die most common words of a topic for each covariate.

topic <- 50

plotQuote(c(paste(sagelabs$cov.betas[[1]]$problabels[topic,], collapse="\n"),
            paste(sagelabs$cov.betas[[2]]$problabels[topic,], collapse="\n"),
            paste(sagelabs$cov.betas[[3]]$problabels[topic,], collapse="\n"),
            paste(sagelabs$cov.betas[[4]]$problabels[topic,], collapse="\n"),
            paste(sagelabs$cov.betas[[5]]$problabels[topic,], collapse="\n"),
            paste(sagelabs$cov.betas[[6]]$problabels[topic,], collapse="\n"),
            paste(sagelabs$cov.betas[[7]]$problabels[topic,], collapse="\n")))
topics <- matrix(c(1, "SPD, M.Schulz", 2, "B90/ Die Grüne", 3, "Mix: Akhanli, Guttenberg, Bayern", 4, "Great Coalition debates", 5, "Diesel scandal", 6, "H.Kohl", 7, "Federal Election results", 8, "Europa, Macron, Schäuble", 9, "Mix: political trends, twitter", 10, "Merkel vs. Schulz", 11, "politics & democracy in GER", 12, "Deportation of criminal Refugees", 13, "A.Merkel", 14, "Text processing fail", 15, "Israel, antisemitism, D.Trump", 16, "Mix: political talkshows, Refugees", 17, "Decision about GroKo in the SPD", 18, "Election in Niedersachsen", 19, "N.Lammert", 20, "AfD", 21, "German armed forces, v.d.Leyen", 22, "SPD, stuffing debates", 23, "CSU, Söder vs. Seehover, refugee cap", 24, "Bundespräsident F.-W.Steinmeier", 25, "Election polls", 26, "Reelections after Jamaica failure", 27, "Jamaica caolition talks", 28, "G20 in Hamburg", 29, "Federal Constitutional Court, Ministry of the Interior", 30, "F.Petri, AfD", 31, "D.Trump, Russia", 32, "Gauland, Weidel, AfD", 33, "German armed forces, Mali", 34, "Mix: Children, Education, Women", 35, "Left- rightwing Terror, police reports", 36, "Mix: people, Germany, democracy", 37, "AfD in parliament", 38, "EU policies", 39, "Mix: Terror attacks", 40, "Mix: Metoo, SPD", 41, "Terror attack Berlin (Amri)", 42, "Refugee family reunion", 43, "Mix: studies", 44, "Federal Constitutional Court (NSU, Franco, Terror)", 45, "Mix: minister of the interior, environment", 46, "CDU, Spahn", 47, "Church", 48, "public budget statistics, Education and Healthcare", 49, "Turkey", 50, "Höcke, Holocaust"), ncol=2, byrow=T)

topics.df <- as.data.frame(topics) %>%
  transmute(topic_name = paste(V1, V2, sep=": "),
         topic = 1:k)

Posterior distribution (gamma)

The theta Matrix is a DxK Matrix that gives us a probability for each topic (K) and each document (D)

# Document-topic probabilities
stmOut %>% tidy("theta") -> theta

The probability of each topic for documents 1-5 can be plotted as:

theta %>%
  filter(document < 6) %>%
  ggplot(aes(factor(topic), gamma, 
             fill = factor(document))) +
  geom_col(position = "dodge") +
  scale_fill_manual(values = col,
                    guide = guide_legend(
                      nrow = 1
                    )) +
  labs(x = "Topic", fill = "Document",
       title = "Gamma distribution of documents 1-5") +
  theme(legend.position = "bottom")

As you can see, only document 2 cannot be assigned to any topic with a high probability. In the case of the other documents, it is highly likely that it belongs to a particular topic.

To get a better understanding of the distribution of the “highest gamma”, we assign a topic to each document (topic with highest postertior distribution).

top_topics <- theta %>% 
  group_by(document) %>%
  mutate(therank = rank(-gamma)) %>%
  filter(therank == 1) %>%
  select(- therank)

btw.2 <- btw %>%
  mutate(document = articleID) %>%
  merge(.,top_topics, by="document") %>%
  ## Combine with Topic label
  merge(., topics.df, by="topic") %>%
  mutate(allocation = 1) 
ggplot(btw.2, aes(gamma)) +
  geom_density(fill=col[3], alpha = 0.8,
               color = col[3]) +
  labs(title = "Density Plot / Posterior distribution",
       y = "Theta")

3.1. Topic proportions

In order to get an initial overview of the results, the figure below displays the topics ordered by their expected frequency across the corpus (left side of the Figure) and the expected proportion of a topic in public media minus the expected proportion of topic use in private media (right side of the Figure). Thus topics more associated with public media appear to the right of zero. To assign a label to each topic, I looked at the most frequent words in that topic and the most representative articles.

keep <- seq(1:k)
Here, I create a Dataframe that contains the columns means of theta (per topic and covariate level)
frequency <- as.data.frame(colMeans(stmOut$theta)) %>%
  mutate(frequency = colMeans(stmOut$theta),
         topic = topics[,1],
         topic_name=paste(topics[,1],topics[,2], 
                          sep=": ")) %>%
  filter(topic %in% keep)

freq <- tapply(stmOut$theta[,1], stmOut$settings$covariates$betaindex, mean)
freq <- as.data.frame(freq) %>% 
    mutate(site=stmOut$settings$covariates$yvarlevels,
           topic = 1)

for(i in 2:k) {
  freq1 <- tapply(stmOut$theta[,i], stmOut$settings$covariates$betaindex, mean)
  freq1 <- as.data.frame(freq1) %>% 
    transmute(site=stmOut$settings$covariates$yvarlevels,
           topic = i,
           freq = freq1)
  
  freq <- rbind(freq, freq1)
}

freq <- freq %>%
  left_join(., topics.df, by = "topic") %>%
  #filter(topic %in% keep) %>%
  mutate(topic = topic_name) %>%
  left_join(., frequency %>% select(topic, frequency),
            by = "topic")

Next, we can plot the expected proportion of topic use in the overall corpus vs. the expected proportion of topic use for each medium.

p1 <- ggplot(frequency, aes(x=reorder(topic_name, frequency), y=frequency)) + 
    geom_col(fill=col[1], alpha=0.8) +
    coord_flip() +
    labs(x="", y="expected frequency") +
    theme(axis.text.x = element_text(size=8),
          axis.text.y = element_text(size=11),
          axis.title = element_text(size=10))

p1

p2 <- freq %>%
  mutate(topic =  as.numeric(gsub(":.*$","",topic))) %>% 
  ggplot(aes(reorder(topic_name,topic), freq)) +
  geom_col(fill = col[3]) +
  coord_flip() +
  facet_wrap(~site, ncol = 7) +
  theme(
    #axis.text.y = element_blank(),
          axis.text.y = element_text(size=11),
          axis.title = element_text(size=10)) +
    labs(x="", y="expected frequency") 

p2

Keep only those articles, that are clear & interessting to analyse.

keep <- c(1,2,4,10,13,17,20,22,26,27,37,46)

3.2. Difference in topic prevalence

To identify which of these differences is significant, the conditional expectation of topic prevalence for given document characteristics can be estimated. More specifically, I estimate a linear model, where the documents are observations, the dependent variable is the posterior probability of a topic and the covariates are the metadata of documents (see equation below).

\[ \theta_d=\alpha+\beta_1x_{ownership}+\beta_2x_{month}+\epsilon \]

The estimateEffect() uses the method of composition to incorporate uncertainty in the dependent variable, drawing a set of topic proportions from the variational posterior repeated times and compute the coefficients as the average over all results.

effect <- estimateEffect(c(1:k) ~site, stmOut, 
                         metadata = out$meta, uncertainty = "None")

Here, I create a dataframe that contains the results of the estimation.

tables <- vector(mode="list", length = length(effect$topics))

for (i in seq_along(effect$topics)) {
  sims <- lapply(effect$parameters[[i]], function(x) stm:::rmvnorm(500, x$est, x$vcov))
  sims <- do.call(rbind, sims)
  est <- colMeans(sims)
  se <- sqrt(apply(sims,2, stats::var))
  tval <- est/se
  rdf <- nrow(effect$data) - length(est)
  p <- 2*stats::pt(abs(tval), rdf, lower.tail = FALSE)
  topic <- i
  
  coefficients <- cbind(topic, est, se, tval, p)
  rownames(coefficients) <- attr(effect$parameters[[1]][[1]]$est, "names") 
  colnames(coefficients) <- c("topic", "Estimate", "Std. Error", "t value", "p")
  tables[[i]] <- coefficients
}

out1 <- list(call=effect$call, topics=effect$topics, tables=tables)

coeff <- as.data.frame(do.call(rbind,out1$tables))

coeff <- coeff %>% 
  mutate(parameter = rownames(coeff),
         parameter = gsub("site", "", parameter),
         signifcant = ifelse(p <= 0.5,"yes","no")) %>%
  left_join(., topics.df, by="topic")

The following figure shows the regression results for each news page. The coefficients indicate the deviation from the base value of Bild.de (keeping the month equal).

p1 <- coeff %>% 
  filter(topic %in% keep) %>%
  filter(parameter %in% stmOut$settings$covariates$yvarlevels) %>%
  ggplot(aes(x = reorder(topic_name,topic, decreasing=F), y = Estimate, fill=factor(signifcant))) +
  geom_col() +
  scale_fill_manual(values = col[c(2,1)]) +
  scale_x_discrete(position = "top") +
  coord_flip() +
  facet_wrap(~parameter, ncol = 8, scales = "free_x") +
  labs(x="", fill="significant at the 5% level") +
  theme(legend.position = "top", 
        axis.text.y = element_text(size=9),
        axis.text.x = element_text(angle=90)) 

p1

# ggsave(plot = p1, filename = "../figs/estimates.png", device = "png",width = 10, height = 7,
# dpi = 600)

Sentiment analysis

The idea of Sentiment analysis is to determine the attitude of a writer through online text data toward certain topic or the overall tonality of a document.

Lexical or “bag-ofwords” approaches are commonly used. In that approach, the researcher provides pre-defined dictionaries (lists) of words associated with a given emotion, such as negativity. The target text is then deconstructed into individual words (or tokens) and the frequencies of words contained in a given dictionary are then calculated.

1. Load sentiment dictionary.

SentimentWortschatz, or SentiWS for short, is a publicly available German-language resource for sentiment analysis, opinion mining etc. It lists positive and negative polarity bearing words weighted within the interval of [-1; 1] plus their part of speech tag, and if applicable, their inflections. The current version of SentiWS (v1.8b) contains 1,650 positive and 1,818 negative words, which sum up to 15,649 positive and 15,632 negative word forms incl. their inflections, respectively. It not only contains adjectives and adverbs explicitly expressing a sentiment, but also nouns and verbs implicitly containing one.

sent <- c(
  # positive Wörter
  readLines("dict/SentiWS_v1.8c_Negative.txt",
            encoding = "UTF-8"),
  # negative Wörter
  readLines("dict/SentiWS_v1.8c_Positive.txt",
            encoding = "UTF-8")
) %>% lapply(function(x) {
  # Extrahieren der einzelnen Spalten
  res <- strsplit(x, "\t", fixed = TRUE)[[1]]
  return(data.frame(words = res[1], value = res[2],
                    stringsAsFactors = FALSE))
}) %>%
  bind_rows %>% 
  mutate(word = gsub("\\|.*", "", words) %>% tolower,
         value = as.numeric(value)) %>%
  # manche Wörter kommen doppelt vor, hier nehmen wir den mittleren Wert
  group_by(word) %>% summarise(value = mean(value)) %>% ungroup

# sent %>% 
#   dplyr::top_n(10, desc(value)) %>%
#   htmlTable::htmlTable()

2. Apply the dictionary on the artciles.

We now take each word in each article and assign a sentiment value for that word. I only use articles that have been assigned a topic with a probability of over 90% (gamma > 0.9).

Check the analysis for a set of example documents.
sentDF %>% filter(document == unique(sentDF$document)[1]) %>%
  select(title, word, value, site) %>%
  htmlTable::htmlTable(align = "l")
title word value site
1 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! drei Bild.de
2 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spd Bild.de
3 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! vorsitzende Bild.de
4 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! hat Bild.de
5 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! andrea Bild.de
6 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nahles Bild.de
7 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gestürzt Bild.de
8 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! oder Bild.de
9 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! an Bild.de
10 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihrem Bild.de
11 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sturz -0.6316 Bild.de
12 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mitgewirkt Bild.de
13 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! rudolf Bild.de
14 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! scharping Bild.de
15 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 1995 Bild.de
16 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! franz Bild.de
17 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! müntefering Bild.de
18 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 2005 Bild.de
19 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
20 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jetzt Bild.de
21 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! martin Bild.de
22 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schulz Bild.de
23 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! heute Bild.de
24 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! tritt Bild.de
25 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
26 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
27 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 47 Bild.de
28 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jährige Bild.de
29 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! selbst Bild.de
30 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! an Bild.de
31 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
32 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spitze 0.2112 Bild.de
33 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
34 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spd Bild.de
35 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! als Bild.de
36 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! erste Bild.de
37 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! frau Bild.de
38 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
39 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
40 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! geschichte Bild.de
41 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
42 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! partei Bild.de
43 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! bis Bild.de
44 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! zum Bild.de
45 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sonderparteitag Bild.de
46 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! im Bild.de
47 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! frühjahr Bild.de
48 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! wird Bild.de
49 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sie Bild.de
50 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! allerdings Bild.de
51 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nur Bild.de
52 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kommissarische Bild.de
53 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! vorsitzende Bild.de
54 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sein Bild.de
55 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nahles Bild.de
56 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! praktizierende Bild.de
57 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! katholikin Bild.de
58 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! star Bild.de
59 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! trek Bild.de
60 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! fan Bild.de
61 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mutter Bild.de
62 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! einer Bild.de
63 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 7 Bild.de
64 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jährigen Bild.de
65 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! tochter Bild.de
66 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
67 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sonst Bild.de
68 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
69 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! künftige Bild.de
70 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spd Bild.de
71 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spitzenfrau Bild.de
72 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! lebt Bild.de
73 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gemeinsam 0.004 Bild.de
74 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
75 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! töchterchen Bild.de
76 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ella Bild.de
77 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! marie Bild.de
78 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
79 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! pferd Bild.de
80 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! siepke Bild.de
81 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! friese Bild.de
82 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! auf Bild.de
83 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! dem Bild.de
84 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! bauernhof Bild.de
85 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihrer Bild.de
86 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! urgroßeltern Bild.de
87 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
88 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
89 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! eifel Bild.de
90 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! fremdelt Bild.de
91 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! etwas Bild.de
92 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
93 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! den Bild.de
94 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sozialen Bild.de
95 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! medien Bild.de
96 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gerade Bild.de
97 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mal Bild.de
98 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 16 Bild.de
99 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 000 Bild.de
100 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! follower Bild.de
101 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! bei Bild.de
102 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! facebook Bild.de
103 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sigmar Bild.de
104 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gabriel Bild.de
105 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 85 Bild.de
106 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 000 Bild.de
107 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! martin Bild.de
108 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schulz Bild.de
109 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 470 Bild.de
110 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 000 Bild.de
111 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! zwei Bild.de
112 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schwere Bild.de
113 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schicksalsschläge Bild.de
114 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
115 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 16 Bild.de
116 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
117 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
118 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 18 Bild.de
119 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! unfall -0.0048 Bild.de
120 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! beim Bild.de
121 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! weitsprung Bild.de
122 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
123 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
124 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schule Bild.de
125 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 8 Bild.de
126 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! hüft Bild.de
127 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ops Bild.de
128 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! seither Bild.de
129 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 50 Bild.de
130 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schwerbehindert Bild.de
131 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schwerer Bild.de
132 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! autounfall Bild.de
133 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! in Bild.de
134 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! schweden Bild.de
135 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nicht Bild.de
136 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! angeschnallt Bild.de
137 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! daher Bild.de
138 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
139 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! narbe Bild.de
140 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! auf Bild.de
141 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
142 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! stirn Bild.de
143 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihr Bild.de
144 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! größter Bild.de
145 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! fan Bild.de
146 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kanzlerin Bild.de
147 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! merkel Bild.de
148 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! die Bild.de
149 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! regierungschefin Bild.de
150 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! lobt Bild.de
151 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! überall Bild.de
152 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nahles Bild.de
153 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kompetenz 0.004 Bild.de
154 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! und Bild.de
155 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! faktensicherheit Bild.de
156 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! als Bild.de
157 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ministerin Bild.de
158 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sagt Bild.de
159 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! über Bild.de
160 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sie Bild.de
161 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
162 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihr Bild.de
163 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kann Bild.de
164 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! man Bild.de
165 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! arbeiten Bild.de
166 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! auch Bild.de
167 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! nach Bild.de
168 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! der Bild.de
169 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! trennung -0.5071 Bild.de
170 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! von Bild.de
171 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ehemann Bild.de
172 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! marcus Bild.de
173 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! frings Bild.de
174 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! 49 Bild.de
175 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! vor Bild.de
176 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! zwei Bild.de
177 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! jahren Bild.de
178 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gab Bild.de
179 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! es Bild.de
180 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! keinen Bild.de
181 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! rosenkrieg Bild.de
182 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! beide Bild.de
183 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! elternteile Bild.de
184 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! kümmern 0.2016 Bild.de
185 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! sich Bild.de
186 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gemeinsam 0.004 Bild.de
187 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! um Bild.de
188 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! tochter Bild.de
189 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ella Bild.de
190 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! marie Bild.de
191 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gemeinsamkeit Bild.de
192 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! mit Bild.de
193 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! ihrem Bild.de
194 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! parteifeind Bild.de
195 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! gabriel Bild.de
196 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! beide Bild.de
197 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! spielen Bild.de
198 Erstmals soll eine Frau die SPD anführen - SO hart ist Andrea Nahles im Nehmen! akkordeon Bild.de

3. Calculate sentiment value by document

We apply two different measurements:

  1. Weighted calculates the score based on the weighted values for a word. As explained above, the dictionary places the words on an interval of -1 and 1. The score is then calculated from the sum of the words in a document (which can be assigned to a word from the dictionary) divided by the total number of words in that document.

\[ \text{Weighted}_d = \frac{|\text{positive polarity score}_d| - |\text{negative polarity score}_d|}{\text{Total Words}_d} \]

  1. Count calculates the score as the difference of positive and negative words (dummy) divided divided by the total number of words in that document. This value therefore only reflects the relation between positive and negative words, without considering the weighting of these words.

\[ \text{Count}_d = \frac{\text{Sum of positive Words}_d - \text{Sum of negative Words}_d}{\text{Total Words}_d} \]

sentDF.values <- sentDF %>%
  select(document, word, value, 
         negative, positive,
         negative_d, positive_d) %>%
  group_by(document) %>%
  
  # calculate sum of positive and negative values
  summarise(sum_positive = sum(positive, na.rm = T),
            sum_negative = sum(negative, na.rm = T),
            sum_positive_d = sum(positive_d, na.rm = T),
            sum_negative_d = sum(negative_d, na.rm = T)) %>%

  # calculate diff
  mutate(sent_diff = sum_positive + sum_negative,
         sent_diff_d = sum_positive_d - sum_negative_d) %>%
  
  # combine with dataframe
  left_join(., df, 
            by = "document") %>%
  # calculate sentiment
  mutate(sentiment_d = sent_diff_d / text_length,
         sentiment = sent_diff / text_length)

4. Plot Sentiment

4.1. by topic
p <- sentDF.values %>%
  group_by(topic_name) %>%
  summarise(sentiment_d = mean(sentiment_d, na.rm=T),
            sentiment = mean(sentiment, na.rm=T),
            obs = n())

## weighted ##
p1 <- ggplot(p, aes(reorder(topic_name, sentiment), 
              sentiment,
              label = obs)) +
  geom_col(fill = col[1], alpha = 0.7) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  labs(x="", y="",
       title = "Weighted") +
  theme(axis.text.y = element_text(size = 8))

## unweighted ##
p2 <- ggplot(p, aes(reorder(topic_name, sentiment), 
              sentiment_d,
              label = obs)) +
  geom_col(fill = col[4], alpha = 0.7) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  labs(x="", y="",
       title = "Count") +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank())

p1 + p2

4.2. by site
p <- sentDF.values %>%
  group_by(site) %>%
  summarise(sentiment_d = mean(sentiment_d, na.rm=T),
            sentiment = mean(sentiment, na.rm=T),
            obs = n())

## weighted ##
p1 <- ggplot(p, aes(reorder(site, sentiment), 
              sentiment,
              label = obs)) +
  geom_col(fill = col[1], alpha = 0.7) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  labs(x="", y="",
       title = "Weighted") +
  theme(axis.text.y = element_text(size = 8))

## unweighted ##
p2 <- ggplot(p, aes(reorder(site, sentiment), 
              sentiment_d,
              label = obs)) +
  geom_col(fill = col[4], alpha = 0.7) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  labs(x="", y="",
       title = "Count") +
  theme(axis.text.y = element_blank(),
        axis.ticks.y = element_blank())

p1 + p2

4.3. By site and topic
p <- sentDF.values %>%
  group_by(site, topic_name, topic) %>%
  summarise(sentiment = mean(sentiment, na.rm=T),
            sentiment_d = mean(sentiment_d, na.rm=T),
            obs = n())

p1 <- ggplot(p, 
       aes(reorder(topic_name, topic), 
           sentiment, label = obs)) +
  geom_col(fill=col[1], alpha = 0.7) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  facet_wrap(~site, ncol = 7) +
  labs(x="", y="",
       title = "Weighted") +
  theme(axis.text.y = element_text(size=8))

p2 <- ggplot(p, 
       aes(reorder(topic_name, topic), 
           sentiment_d, label = obs)) +
  geom_col(fill=col[4], alpha = 0.7) +
  #geom_text() +
  geom_hline(yintercept = 0, linetype = 2,
             color = "black") +
  coord_flip() +
  facet_wrap(~site, ncol = 7) +
  labs(x="", y="",
       title = "Count") +
  theme(axis.text.y = element_text(size=8))

p1 + p2 + plot_layout(ncol = 1)

4.4. Radar plot
require(ggiraph)
require(ggiraphExtra)
sentDF.values %>%
  group_by(site, topic_name) %>%
  summarise(sentiment = mean(sentiment, na.rm=T)) %>%
  spread(key=topic_name, value=sentiment) -> radar

radar %>%
  ggRadar(aes(color=site), 
          rescale = F,
          alpha = 0, legend.position = "right") +
  labs(title = "Weighted")

sentDF.values %>%
  group_by(site, topic_name) %>%
  summarise(sentiment = mean(sentiment_d, na.rm=T)) %>%
  spread(key=topic_name, value=sentiment) -> radar

radar %>%
  ggRadar(aes(color=site), 
          rescale = F,
          alpha = 0, legend.position = "right") +
  labs(title = "Count")

Weighted

Count

5. SenitmantR

pacman::p_load(sentimentr)
sent %>%
  mutate(polarity = value) %>%
  as_key() -> sentiment_df
## Warning in as_key(.): One or more terms in the first column appear as terms in the comparison.
##   I found the following dubious fellas:
## 
##    * not
## 
## These terms have been removed.

Output

We may wish to see the output from sentiment_by line by line with positive/negative sentences highlighted. The highlight function wraps a sentiment_by output to produces a highlighted HTML file (positive = green; negative = pink). Here we look at a random article for each site.

df %>% 
  mutate(text_split = get_sentences(text)) %$%
  sentiment(text_split,
               polarity_dt = sentiment_df) -> df_sent

df %>% 
  group_by(site) %>%
  sample_n(1) %>%
  mutate(text_split = get_sentences(title_text)) %$%
  sentiment_by(text_split, site,
               polarity_dt = sentiment_df) %>%
  sentimentr::highlight()
## Saved in polarity.html
## Opening polarity.html ...

Polarity